home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Toolbox classes / List manager < prev    next >
Text File  |  1994-05-08  |  15KB  |  554 lines
  1. \ List manager class - thanks to Greg Haverkamp for this.
  2. \ Note that Greg wrote this for Mops 2.3, before controls became views.
  3. \ Therefore some things could probably be simplified a bit under 2.4.
  4. \ I've checked it compiles, but that's all.   -- Mike.
  5.  
  6. \ Here's Greg's .sig:
  7.  
  8. \ Greg Haverkamp -- gh1w@andrew.cmu.edu, dietcoke+@cmu.edu
  9. \ Industrial Management - '94
  10. \ Carnegie Mellon University, Pittsburgh, Pennsylvania
  11. \
  12. \ "Sometimes I think life is just a rodeo.  The trick is to ride and make
  13. \ it to the bell."  John Fogerty, "Rock and Roll Girls"
  14.  
  15.  
  16.  
  17. \ The following classes provide support for the Mac Toolbox List
  18. \ Manager package.  Unfortunately, some of this support is less than
  19. \ elegant, so please be sure to read the accompanying explanatory
  20. \ info before using the routines.
  21. \ Greg Haverkamp
  22.  
  23. need    window+
  24.  
  25. string tempString
  26.  
  27.  
  28. \ Class MyPtrList
  29. \
  30. \ Okay, this is almost entirely a ripoff of Class PtrList from View.  All I
  31. \ did was add a remove: method so that when a list is killed, we can rid
  32. \ ourselves of it.
  33.  
  34. :CLASS MyPtrList super{ string+ sequence } \ With lots stolen from PtrList
  35.  
  36.     
  37.     
  38.     :m Add:        \ ( ptr -- )
  39.         pad !  pad 4  add: super  ;m
  40.  
  41.     :m First?:
  42.         size: super  nif  false  exit  then   \ No elements - return false
  43.         reset: super  ^1st: super @  true  ;m
  44.  
  45.     :m Next?:    \ ( -- ptr T  |  -- F )
  46.         4 skip: super  len: super  NIF  false  exit  THEN
  47.         ^1st: super  @  true  ;m
  48.         
  49.     :m Remove: ( ptr -- b ) \ Returns true if found, false if not.
  50.         pad ! pad 4
  51.         search: self
  52.         if
  53.             step: self
  54.             4 deleteN: self
  55.             true
  56.         else
  57.             false
  58.         then
  59.         ;m
  60.         
  61.     :m Length?: ( -- n )
  62.         size: super
  63.         ;m
  64. ;CLASS        
  65.  
  66.             
  67.             
  68.  
  69.  
  70. \ Class ListWindow
  71. \
  72. \ This class provides support for lists, especially for controlling the 
  73. \ actions of List Manager-created scroll bars.
  74. \ Greg Haverkamp
  75.  
  76. :CLASS ListWindow super{ window+ }
  77.  
  78.  
  79.  
  80. \ Content:  This method is necessary for a number of reasons.  However,
  81. \ in talking to Mike, its necessity might change.  If you look at the
  82. \ content: method in Window+, then you'll notice that the first
  83. \ thing it does is to check to see if a control was hit, and if it was,
  84. \ it tries to find the control's handler.  This did not sit well with
  85. \ the List Manager, as it like to control its own scroll bar.
  86. \ Therefore, this content: checks through the ptrlist of Lists to
  87. \ to see if they should handle it.
  88.  
  89.     :m CONTENT:        \ Handles a content click, checking for lists first.
  90.         active: self   \ Find out if this window is active
  91.         IF    
  92.             get: ^contView ListCheck: **    \ Check any lists in the contView
  93.             NIF
  94.                 noClip  get: ^contView  click: **  drop
  95.                                             \ Or just a click in a view
  96.             THEN
  97.         ELSE
  98.             select: self
  99.         THEN
  100.         ;m
  101.         
  102. ;CLASS
  103.  
  104.  
  105. \ Class List
  106. \
  107. \ This class provides for the basic structure and needs of a list.
  108. \ Greg Haverkamp 6 August 93
  109. \
  110. \ Note that I attempted, when possible, to use the Mops naming scheme for
  111. \ everything.  However, that was not always practical, so many things are
  112. \ named for their toolbox calls.
  113. \
  114. \ Here is the process for creating a list and a listView:
  115. \ 1) Create a contView of class ListView
  116. \      ListView MyContView
  117. \ 2) Create any objects of class ListView
  118. \      ListView MyListView
  119. \ 3) Create any other views you might have
  120. \      view MyRegularView
  121. \ 4) Create the list you want
  122. \      List MyList
  123. \ 5) Add all of the sub-views to the contView
  124. \      MyListView addListView: MyContView
  125. \      MyRegularView addView: MyContView
  126. \    (NOTE: You use addListView: for sub-views of type ListView, but continue
  127. \     to use the method addView: for regular views.  The class ListView will
  128. \     handle the differentiation.)
  129. \ 6) Set up all of the parameters as described for NewList:
  130. \ 7) Execute ^theView NewList:
  131. \ 8) Add the lists to the appropriate view
  132. \      MyList addList: MyListView
  133. \ 9) Serve hot and enjoy.  :)
  134.  
  135.  
  136. :CLASS List super{ object }
  137. record
  138. {    handle    ListHandle
  139.     handle ListRegion \ Needed for updating
  140.     ptr ListPointer
  141.     rect rView
  142.     rect dataBounds
  143.     point cSize
  144.     int theProc
  145.     ptr WindowPtr
  146.     bool drawIt
  147.     bool hasGrow
  148.     bool scrollHoriz
  149.     bool scrollVert
  150.     bool List?
  151.     ptr MyView
  152. }    
  153.     
  154.     
  155. \ My flag hacks.  Sorry about the pain in the butt these cause.
  156. \ List: should be set true as soon as a list is successfully started.
  157. \ List?: can be used to see if there is a list present.  This might
  158. \ seem odd, but it became necessary in the list checking for the 
  159. \ writing of ListWindow's Content: method.
  160. \
  161. \ Well, these are not such a pain now, as the list creation methods now
  162. \ take care of setting them.  GAH 6 Aug 93
  163.  
  164.     :m List: ( bool -- ) \ put true in here after you have called NewList:
  165.         put: List?         \ for the pertinent list.
  166.         ;m
  167.                  
  168.                 
  169.     :m List?: ( -- bool ) \ I dunno if you'll ever need to use this, but
  170.         get: List?          \ this can be used to check to make sure a list
  171.         ;m                \ exists prior to calling List Manager routines.
  172.                           \ If you don't, you can get some very nasty
  173.                           \ results. (I don't much care for the way
  174.                           \ MacsBug fills up my screen.)
  175.         
  176.         
  177.  
  178.  
  179. \ We use explicit names here to make it very clear which portions
  180. \ of the list parameters we are modifying.  As I say later, I also
  181. \ prefer this to having a HUGE list of unnamed parameters.
  182.  
  183.     :m PutrView:   ( l t r b -- )
  184.         put: rView
  185.         ;m
  186.         
  187.     :m PutDataBounds: ( l t r b -- )
  188.         put: dataBounds
  189.         ;m
  190.         
  191.     :m PutcSize: ( x y -- ) \ 0 0 will force auto-calc by toolbox
  192.         put: cSize
  193.         ;m
  194.         
  195.     :m PuttheProc: ( n -- ) \ 0 for default List Manager LDEF
  196.         put: theProc
  197.         ;m
  198.         
  199.     :m PutWindowPtr: ( ptr -- )
  200.         put: WindowPtr
  201.         ;m
  202.         
  203.     :m PutdrawIt: ( bool -- ) \ Drawing on?
  204.         put: drawIt
  205.         ;m
  206.         
  207.     :m PutHasGrow: ( bool -- ) \ Does the window have a grow box?
  208.         put: hasGrow
  209.         ;m
  210.         
  211.     :m PutScrollHoriz: ( bool -- ) \ Do we want a horiz scrollbar?
  212.         put: ScrollHoriz
  213.         ;m
  214.     
  215.     :m PutScrollVert: ( bool -- ) \ Do we want a vert scrollbar?
  216.         put: ScrollVert
  217.         ;m
  218.         
  219.     :m PutRegion: ( rgnHandle -- )
  220.         put: ListRegion
  221.         ;m
  222.         
  223. \ I'm not sure why I put this in here... but we'll leave it should
  224. \ we ever decide we need it.
  225.  
  226.     :m Handle: ( -- handle )
  227.         get: ListHandle
  228.         ;m
  229.     
  230. \ Creating and Disposing of Lists
  231.  
  232.  
  233.     :m New: { ^View --  } \ Call this to create a new list, but
  234.                     \ Be sure that you first make sure you have
  235.                     \ set up all the parameters.
  236.                     \ I just prefer doing it this way so that all of the
  237.                     \ items are well known, and the placement order
  238.                     \ doesn't matter.
  239.         0 \ Leave room for return handle
  240.         addr: rView 
  241.         addr: dataBounds 
  242.         int: cSize 
  243.         int: theProc 
  244.         get: WindowPtr
  245.         get: drawIt tbool   
  246.         get: hasGrow tbool 
  247.         get: scrollHoriz tbool 
  248.         get: scrollVert tbool   
  249.         call lNew
  250.         put: ListHandle
  251.         true
  252.         List: self
  253.         ^View put: MyView
  254.         ;m
  255.         
  256.     :m Dispose: ( -- ) \ Call this when you're done to clean
  257.                        \ things up.  (these lists can really
  258.                        \ suck memory when they get big.)
  259.         get: ListHandle
  260.         call lDispose
  261.         false
  262.         List: self
  263.         ^base get: myView removeList: **
  264.         ;m
  265.         
  266. \ Adding and Deleting Rows and Columns
  267.  
  268.     :m AddColumn: { count colNum -- } \ this returns the col # added
  269.         0 \ make room
  270.         count colNum pack
  271.         get: ListHandle
  272.         call lAddColumn
  273.         ;m
  274.     
  275.     :m AddRow: { count rowNum -- } \ this returns to row # added
  276.         0 \ make room
  277.         count rowNum pack
  278.         get: ListHandle
  279.         call lAddRow
  280.         ;m
  281.         
  282.     :m DeleteColumn: ( count colNum -- ) \ See ya buddy.
  283.         get: ListHandle
  284.         call lDelColumn
  285.         ;m
  286.         
  287.     :m DeleteRow: ( count rowNum -- ) \ And your friend, too.
  288.         get: ListHandle
  289.         call lDelRow
  290.         ;m
  291.         
  292. \ Operations on Cells
  293.  
  294.     :m Add: { addr len theCell -- } \ This will add information to
  295.                                     \ what is currently contained
  296.                                     \ in the cell.
  297.         addr
  298.         len makeint
  299.         theCell
  300.         get: ListHandle
  301.         call lAddToCell
  302.         ;m
  303.         
  304.     :m Clear: ( theCell -- ) \ This, of course, clears the cell.
  305.         get: ListHandle
  306.         call lClrCell
  307.         ;m
  308.         
  309.     :m Get: ( addr ^len theCell -- ) \ This will give you the string
  310.                                          \ from a cell.
  311.         get: ListHandle
  312.         call lGetCell
  313.         ;m
  314.         
  315.     :m put: { addr len theCell -- } \ Use this to store info into a
  316.                                     \ cell.  Note that this will
  317.                                     \ overwrite anything that was
  318.                                     \ already there.
  319.         addr
  320.         len makeint
  321.         theCell
  322.         get: ListHandle
  323.         call lSetCell
  324.         ;m
  325.         
  326.     :m CellSize: ( cSize -- )
  327.         get: ListHandle
  328.         call lCellSize
  329.         ;m
  330.         
  331.     :m Selected?: { next ^theCell -- }
  332.         word0 \ make room for return
  333.         next
  334.         ^theCell
  335.         get: ListHandle
  336.         call lGetSelect
  337.         ;m
  338.         
  339.     :m Deselect: { theCell -- }
  340.         false tbool
  341.         theCell
  342.         get: ListHandle
  343.         call lSetSelect
  344.         ;m
  345.         
  346.     :m Select: { theCell -- }
  347.         true tbool
  348.         theCell
  349.         get: ListHandle
  350.         call lSetSelect
  351.         ;m
  352.         
  353. \ Mouse Location
  354.  
  355.     :m Click: { pt modifiers -- b } \ Handles a click in the list's view.
  356.                                      \ Returns true if double click.
  357.         word0 \ make room
  358.         pt
  359.         modifiers makeint
  360.         get: ListHandle
  361.         call lClick
  362.         ;m
  363.         
  364.     :m WhichCell?: ( -- theCell ) \ Which was the last cell clicked in?
  365.                                   \ The key here is that this was actually
  366.                                   \ just the last cell that was clicked
  367.                                   \ in... no necessarily the selected cell.
  368.                                   \ Primarily, though, it will probably
  369.                                   \ be the same thing.  
  370.         0 \ make room
  371.         get: ListHandle
  372.         call lLastClick
  373.         ;m
  374.         
  375. \ Accessing Cells
  376. \ These are all untested.  I can't verify that they work.
  377.  
  378.     :m Find: ( ^offset ^ length theCell -- )
  379.         get: listHandle
  380.         call lFind
  381.         ;m
  382.         
  383.     :m NextCell: { hNext vNext ^theCell -- b }
  384.         word0
  385.         hNext tbool
  386.         vNext tbool
  387.         ^theCell
  388.         get: ListHandle
  389.         call lNextCell
  390.         ;m
  391.         
  392.     :m Rect: ( ^cellRect theCell -- )
  393.         get: listHandle
  394.         call lRect
  395.         ;m
  396.         
  397.     :m Search: { addr len ^searchProc ^theCell -- b }
  398.         word0
  399.         addr
  400.         len makeint
  401.         ^searchProc
  402.         ^theCell
  403.         get: ListHandle
  404.         call lSearch
  405.         ;m
  406.         
  407.     :m Size: { width height -- }
  408.         width makeint
  409.         height makeint
  410.         get: ListHandle
  411.         call lSize
  412.         ;m
  413.         
  414. \ List Display
  415.  
  416.     :m DrawCell: ( theCell -- ) \ Draw a particular cell.
  417.         get: ListHandle
  418.         call lDraw
  419.         ;m
  420.         
  421.     :m DoDraw: ( drawIt -- ) \ turns on drawing.
  422.         tbool
  423.         get: ListHandle
  424.         call lDoDraw
  425.         ;m
  426.         
  427.     :m Scroll: ( dcols dRows -- ) \ In case you want to scroll this puppy
  428.                                   \ by yourself.
  429.         get: ListHandle
  430.         call lScroll
  431.         ;m
  432.         
  433.     :m AutoScroll: ( -- ) \ Will scroll the first highlighted item.
  434.         get: ListHandle
  435.         call lAutoScroll
  436.         ;m
  437.         
  438.     :m Update: ( theRgn -- ) \ Redraws the list.
  439.         get: ListRegion
  440.         get: ListHandle
  441.         call lUpdate
  442.         ;m
  443.         
  444.     :m Activate: (  -- )
  445.         true tbool
  446.         get: ListHandle
  447.         call lActivate
  448.         ;m
  449.         
  450.     :m Deactivate: ( -- )
  451.         false tbool
  452.         get: ListHandle
  453.         call lActivate
  454.         ;m
  455.         
  456.         
  457.         
  458.     
  459. ;CLASS
  460.  
  461.  
  462. \ Class ListView
  463. \
  464. \ This class provides list manager support for views under Mops.
  465. \ Greg Haverkamp
  466.  
  467. \ need ListRecord
  468. \ need ListBlock
  469.  
  470. :CLASS ListView super{ view }
  471. record
  472. {    bool Lists?
  473.     bool List?
  474.     MyPtrList Lists
  475.     MyPtrList SubListViews
  476. }
  477.  
  478. \ * The following are adaptations that allow easier use
  479. \ * of lists... including checking for clicks in the content
  480. \ * and the like.
  481.  
  482.  
  483.     :m List:
  484.         put: List?
  485.         ;m
  486.         
  487.     :m List?:
  488.         get: List?
  489.         ;m
  490.         
  491.     :m Lists:
  492.         put: Lists?
  493.         ;m
  494.         
  495.  
  496.  
  497.  
  498. \ ListCheck: is called by the ListWindow's content: method to see if
  499. \ the click occurred inside of a list.
  500.  
  501.     :m ListCheck:    \ ( -- b )   Returns true if we've handled the click.
  502.         get: Lists?  \ Do we have listViews in this view?
  503.         NIF  
  504.             false
  505.             EXIT  
  506.         THEN
  507.         BEGIN    each: subListviews
  508.         WHILE    
  509.             ListCheck: **  
  510.             IF  
  511.                 uneach: subListviews  
  512.                 true  
  513.                 EXIT  
  514.             THEN
  515.         REPEAT
  516.         0  
  517.         where: fEvent  g->l
  518.         addr: viewRect
  519.         call PtInRect    
  520.         IF        
  521.             exec: clickHndlr
  522.             list?: self \ Is there really a list in this view?
  523.         ELSE    
  524.             false
  525.         THEN   
  526.         ;m
  527.         
  528.     :m addListView: { ptr -- } \ Call this to add a view that possesses a list
  529.         ptr add: SubListViews
  530.         ptr addView: super
  531.         false Lists: self
  532.         false List: self
  533.         ;m
  534.         
  535.     :m AddList: ( ^list -- ) \ Call this to add a list to a listview...
  536.                                 \ but only after calling Newlist:
  537.         add: Lists
  538.         true  Lists: self
  539.         true List: self
  540.         ;m
  541.         
  542.     :m RemoveList: ( ^list -- ) \ Call this to get rid of a list
  543.         remove: lists drop
  544.         length?: lists 0 =
  545.         if
  546.             false Lists: self
  547.             false List: self
  548.         then
  549.         ;m
  550.         
  551.  
  552. ;CLASS
  553.  
  554.